perm filename TEST.SAI[GEO,BGB]1 blob
sn#012704 filedate 1972-11-17 generic text, type T, neo UTF8
00100 BEGIN "TEST"
00200 REQUIRE "ABBREV" SOURCE_FILE;
00300 REQUIRE "DPYIII" SOURCE_FILE;
00400 REQUIRE "DPYIII" LOAD_MODULE;
00700 SAFE INTEGER ARRAY RAN5[0:255];
00800 INTEGER RAN1,RAN2,RAN3,RAN4,INITFLG;
00900 PROCEDURE RANDOMI;
01000 BEGIN "INIT"
01100 INTEGER I;
01200 RAN1←1;
01300 RAN2←3;
01400 FOR I←0 STEP 1 UNTIL 255 DO
01500 RAN5[I]←RAN2←(RAN2*3)MOD 2↑31 ;
01600 INITFLG ← TRUE;
01700 END "INIT";
01800
01900 INTERNAL REAL PROCEDURE RANDOM;
02000 BEGIN "RANDOM"
02100 IF INITFLG THEN ELSE RANDOMI;
02200 RAN1←(RAN2*1756) MOD 8191;
02300 RAN3←RAN1 DIV 32;
02400 RAN4←RAN5[RAN3];
02500 RAN2←RAN5[RAN3]←(RAN2*3)MOD 2↑31;
02600 RETURN(RAN4/2↑31)
02700 END "RANDOM";
00100 α DECLARATIONS;
00200 EXTERNAL SUBR CUBFIT(ITG ARRAY A;REAL ARRAY B;ITG N);
00300 REAL X,Y; INTEGER IX,IY,I,J;
00400 SAFE ITG ARRAY DPYBUF[0:400];
00500 SAFE ITG ARRAY ZZZ[0:200];
00600 SAFE REAL ARRAY XXX[0:200];
00700 SAFE REAL ARRAY YYY[0:200];
00750 REAL SX,X2,X3,SY;
00800
00850 α DISPLAY INITIALIZATION;
00900 DPYSET(DPYBUF); AIVECT(-500,-500);
01000 AVECT(+500,-500); AVECT(+500,+500);
01100 AVECT(-500,+500); AVECT(-500,-500);
01200
01300 AIVECT(-500,0);AVECT(+500,0);
01400 AIVECT(0,-500);AVECT(0,+500);
01500
01600 AIVECT(-400,-400);
01700 AVECT(+400,-400); AVECT(+400,+400);
01800 AVECT(-400,+400); AVECT(-400,-400);
00100 J ← 0;
00200 FOR X ← -1 STEP 0.02 UNTIL +1.01 DO
00300 BEGIN
00400 Y ← ((1.0*X + 0.2)*X - 0.5)*X + 0.05;
00500 IF X=-1 THEN AIVECT(X*400,Y*350) ELSE AVECT(X*400,Y*350);
00600 IX ← 1024*(XXX[J] ← X + 0.3*(RANDOM-0.5));
00700 IY ← 1024*(YYY[J] ← Y + 0.8*(RANDOM-0.5));
00800 S⊂ MOVE 13,IX;HRL 13,IY;MOVEM 13,IX ⊃;
00900 ZZZ[J] ← IX; J←J+1;
01100 END; J←J-1;
01200 FOR I←0 TO J DO
01300 BEGIN
01400 AIVECT(XXX[I]*400-12,YYY[I]*350-9);
01500 DPYSST("o");
01600 END;
01800 CUBFIT(ZZZ,XXX,J);
01900 FOR X←-1 STEP 0.2 UNTIL +1.01 DO
02000 BEGIN Y ← ((XXX[0]*X + XXX[1])*X + XXX[2])*X + XXX[3];
02100 IF X=-1 THEN AIVECT(Y*400,X*350)ELSE AVECT(Y*400,X*350);
02200 END;
02210 DPYOUT(0);
02300 FOR I←1 TO 30 DO OUTSTR(↓);
02400 WHILE TRUE DO INCHRW;
02500 END;